COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Auxilliary record service routines.  
C00003 00003	! rectype, $rectype, cvrts, chkrec, etc
C00008 00004	! cell routines
C00011 ENDMK
C⊗;
COMMENT Auxilliary record service routines.  
	Modified for new-style record descriptors.
	;

ENTRY;

BEGIN "RECAUX"

REQUIRE "ABBREV.SAI[AL,HE]" SOURCE_FILE;
REQUIRE "MACROS.SAI[AL,HE]" SOURCE_FILE;
comment REQUIRE "STCODE.DEF[AL,HE]" SOURCE_FILE;
REQUIRE "SYS:RECORD.DEF" SOURCE_FILE;


DEFINE RPTR="RECORD_POINTER";

! rectype, $rectype, cvrts, chkrec, etc;

INTERNAL INTEGER SIMPLE PROCEDURE RECLEN(RPTR(ANY_CLASS) R);
	START_CODE
	LABEL	XIT;
	SKIPN	1,R;
	JRST	XIT;
	MOVE	1,(1);	! get the descriptor;
	MOVE 	1,3(1); ! the size field therefrom;
XIT:	END;

INTERNAL INTEGER SIMPLE PROCEDURE RECTYPE(RPTR (ANY_CLASS) R);
	START_CODE
	SKIPE	1,R;
	HRRZ	1,(1);
	END;

INTERNAL RPTR($CLASS) SIMPLE PROCEDURE $RECTYPE(RPTR(ANY_CLASS) R);
	START_CODE
	SKIPE	1,R;
	HRRZ	1,(1);
	END;

INTERNAL STRING SIMPLE PROCEDURE CVRCS(RPTR($CLASS) RC);
	RETURN($CLASS:TXTARR[RC][0]);

INTERNAL STRING SIMPLE PROCEDURE CVRTS(INTEGER RT);
	START_CODE
	JRST	CVRCS;
	END;

INTERNAL RPTR(ANY_CLASS) PROCEDURE CHKREC(RPTR(ANY_CLASS) R;INTEGER T);
	BEGIN
	IF T≠0 ∧ RECTYPE(R)≠T THEN
		BEGIN
		USERERR(1,1,(CRLF&"RECORD ")&CVOS(MEMORY[LOCATION(R)])
				&" HAS TYPE "&CVRTS(RECTYPE(R))&
				" INSTEAD OF "&CVRTS(T));
		END;
	RETURN(R);
	END;
! cell routines;

INTERNAL RECORD_CLASS CELL(RPTR (ANY_CLASS) CAR,CDR);

INTERNAL RPTR(CELL) PROCEDURE CONS(RPTR(ANY_CLASS) A,D);
	BEGIN
	RPTR(CELL) C;
	C←NEW_RECORD(CELL);
	CELL:CAR[C]←A;
	CELL:CDR[C]←D;
	RETURN(C);
	END;

INTERNAL RPTR(ANY_CLASS) PROCEDURE LLOP(REFERENCE RPTR(CELL) C);
	BEGIN
	RPTR(ANY_CLASS) V;
	IF RECTYPE(C)≠LOCATION(CELL) THEN 
		BEGIN
		USERERR(1,1,"LLOP CALLED WITH RECORD OF TYPE "&CVRTS(RECTYPE(C)));
		RETURN(NULL_RECORD);
		END;
	V←CELL:CAR[C];
	C←CELL:CDR[C];
	RETURN(V);
	END;

INTERNAL INTEGER PROCEDURE CL_LEN(RPTR(CELL) C);
	BEGIN
	INTEGER I;
	I←0;
	WHILE C≠NULL DO
		BEGIN
		I←I+1;
		C←CELL:CDR[C];
		END;
	RETURN(I);
	END;


INTERNAL RPTR(CELL) PROCEDURE APPEND(RPTR(CELL) ARG1, ARG2);
    BEGIN  "append"  ! Coded by RF;
    !  Appends the two lists by RPLACD on the last CDR field of ARG1;
    RPTR(CELL) P1, P2;
    IF ARG1 = NULL_RECORD THEN RETURN(ARG2);
    P1 ← ARG1;
    WHILE P1 ≠ NULL_RECORD DO
        BEGIN  ! Chain down ARG1 looking for the end;
        P2 ← P1;
        P1 ← CELL:CDR[P1];
        END;
    CELL:CDR[P2] ← ARG2;
    RETURN(ARG1);
    END "append";

INTERNAL RPTR(CELL) PROCEDURE LIST2(RPTR(ANY_CLASS) C1,C2);
	RETURN(CONS(C1,CONS(C2,NULL_RECORD)));

INTERNAL RPTR(ANY_CLASS) PROCEDURE CONSON(RPTR(ANY_CLASS) X;REFERENCE RPTR(CELL) C);
	BEGIN
	C←CONS(X,C);
	RETURN(X);
	END;

INTERNAL BOOLEAN PROCEDURE MEMQ (RPTR(ANY_CLASS) E;RPTR(CELL) L);
	BEGIN
	WHILE L≠NULL_RECORD DO
		BEGIN
		IF E=CELL:CAR[L] THEN RETURN(TRUE);
		L←CELL:CDR[L];
		END;
	RETURN(FALSE);
	END;

END "RECAUX"